home *** CD-ROM | disk | FTP | other *** search
- nstrate the GetImage and PutImage commands }
-
- const
- r = 20;
- StartX = 100;
- StartY = 50;
-
- var
- CurPort : ViewPortType;
-
- procedure MoveSaucer(var X, Y : integer; Width, Height : integer);
- var
- Step : integer;
- begin
- Step := Random(2*r);
- if Odd(Step) then
- Step := -Step;
- X := X + Step;
- Step := Random(r);
- if Odd(Step) then
- Step := -Step;
- Y := Y + Step;
-
- { Make saucer bounce off viewport walls }
- with CurPort do
- begin
- if (x1 + X + Width - 1 > x2) then
- X := x2-x1 - Width + 1
- else
- if (X < 0) then
- X := 0;
- if (y1 + Y + Height - 1 > y2) then
- Y := y2-y1 - Height + 1
- else
- if (Y < 0) then
- Y := 0;
- end;
- end; { MoveSaucer }
-
- var
- Pausetime : word;
- Saucer : pointer;
- X, Y : integer;
- ulx, uly : word;
- lrx, lry : word;
- Size : word;
- I : word;
- begin
- ClearDevice;
- FullPort;
-
- { PaintScreen }
- ClearDevice;
- MainWindow('GetImage / PutImage Demonstration');
- StatusLine('Esc aborts or press a key...');
- GetViewSettings(CurPort);
-
- { DrawSaucer }
- Ellipse(StartX, StartY, 0, 360, r, (r div 3)+2);
- Ellipse(StartX, StartY-4, 190, 357, r, r div 3);
- Line(StartX+7, StartY-6, StartX+10, StartY-12);
- Circle(StartX+10, StartY-12, 2);
- Line(StartX-7, StartY-6, StartX-10, StartY-12);
- Circle(StartX-10, StartY-12, 2);
- SetFillStyle(SolidFill, MaxColor);
- FloodFill(StartX+1, StartY+4, GetColor);
-
- { ReadSaucerImage }
- ulx := StartX-(r+1);
- uly := StartY-14;
- lrx := StartX+(r+1);
- lry := StartY+(r div 3)+3;
-
- Size := ImageSize(ulx, uly, lrx, lry);
- GetMem(Saucer, Size);
- GetImage(ulx, uly, lrx, lry, Saucer^);
- { PutImage(ulx, uly, Saucer^, XORput); { erase im